#!/usr/bin/perl

use strict;
use Data::Dumper;
use FindBin;
use Getopt::Long;
use HTTP::Request::Common;
use HTTP::Request;
use HTTP::Response;
use JSON ();
use LWP::UserAgent;
use Digest::MD5 qw(md5_hex);

my $sgapi_url = "http://socialgraph.apis.google.com/testparse";
my $use_cache = 0;
my $re = "."; # re to match tests against
GetOptions("apiurl=s" => \$sgapi_url,
	   "usecache" => \$use_cache,
	   "match=s"  => \$re,
	   )
    or die "Unknown option(s).\n";

my $testdir  = "$FindBin::Bin/tests";
my $docdir   = "$FindBin::Bin/docs";
my $cachedir = "$FindBin::Bin/cached_responses";

opendir(my $dh, $testdir) or die "Failed to open directory: $!";
my @tests = grep { /$re/ } grep { /\.test$/ } readdir($dh);

my $ua = LWP::UserAgent->new;

sub diag {
    print STDERR "# $_[0]\n";
}

for my $testname (@tests) {
    diag("Running test: $testname");

    my %problems; # type -> [list]
    my $add_problem = sub {
	my ($type, $details) = @_;
	push @{$problems{$type} ||= []}, $details;
    };

    my $url;
    my $file;
    my $mime;
    my %expected_attr;
    my %edge_status; # "n1$;edge_type$;n2" -> Edge
    open(my $fh, "$testdir/$testname") or die "Failed to open $testname: $!";
    while (<$fh>) {
	s/^\s*\#.*//;
	s/\s\#.*//;
	next unless /\S/;
	if (/^URL:\s*(\S+)/i) {
	    $url = $1;
	} elsif (/^content-type:\s*(.*\S)\s*\n/i) {
	    $mime = $1;
	} elsif (/^File:\s*(\S+)/i) {
	    $file = $1;
	} elsif (/^attr\s+(\S+)\s+(.+?)\s*\n/) {
	    $expected_attr{$1} = $2;
	} elsif (/^(\!\s*)?(\S+)\s+(\S+)\s+(\S+)\s*\n/) {
	    my ($bang, $n1, $etype, $n2) = ($1, $2, $3, $4);
	    my $edge = Edge->new($n1, $etype, $n2);
	    if ($bang) {
		$edge->mark_as_unwanted;
	    } else {
		$edge->mark_as_expected;
	    }
	    $edge_status{$edge->hashkey} = $edge;
	} else {
	    die "Unknown line in $testname file:\n$_";
	}
    }

    die "No URL: line for $testname\n" unless $url;
    die "No File: line for $testname\n" unless $file;
    die "No MIME: line for $testname\n" unless $mime;
    
    open(my $bfh, "$docdir/$file") or die "Failed to open file $docdir/$file: $!\n";
    my $body = do { local $/; <$bfh>; };

    #diag("Running $testname testparse with content-type: $mime");
    my $json = get_json_testparse($body, $mime, $url);

    my $res = JSON::from_json($json);
    my @unexpected_edges;
    for my $found_edge_params (@{$res->{edges}}) {
	my $found_edge = Edge->new(@$found_edge_params);
	#diag("Found edge: " . $found_edge->as_string);
	my $edge = $edge_status{$found_edge->hashkey} ||= $found_edge;
	if (!$edge->expected && !$edge->found) {
	    #diag("Unexpected edge found: " . $found_edge->as_string);
	    push @unexpected_edges, $found_edge;
	}
	$edge->mark_as_found;
    }

    foreach my $edge (sort { $a->hashkey cmp $b->hashkey } values %edge_status) {
	if ($edge->expected && !$edge->found) {
	    $add_problem->("missing_edge", $edge->as_string);
	}
	if ($edge->unwanted && $edge->found) {
	    $add_problem->("unwanted_edge", $edge->as_string);
	}
    }

    my %got_attr;
    foreach my $attr (@{$res->{attributes}}) {
	$got_attr{$attr->{attribute}} = $attr->{value};
    }

    foreach my $attr (sort keys %expected_attr) {
	unless (defined $got_attr{$attr}) {
	    $add_problem->("missing_attr", $attr);
	    next;
	}
	unless ($got_attr{$attr} eq $expected_attr{$attr}) {
	    $add_problem->("wrong_attr", "Expected: $expected_attr{$attr}, got: $got_attr{$attr}");
	}
    }

    if (%problems) {
	print STDERR "Errors with $testname:\n", Dumper(\%problems);
    }
}

sub get_json_testparse {
    my ($body, $mime, $url) = @_;
    my $cache_key = md5_hex($body . $mime . $url);
    my $cache_file = "$cachedir/$cache_key.testparse";
    if ($use_cache && -s $cache_file) {
	open(my $fh, $cache_file) or die "Error opening $cache_file: $!";
	return scalar do { local $/; <$fh>; }
    }
    my $api_res = $ua->request(POST $sgapi_url, [body        => $body,
						 contentType => $mime,
						 url         => $url,
						 urlFormat   => "base",
						 ]);
    unless ($api_res->is_success) {
	die "Error from Social Graph API:\n  " . $api_res->status_line . "\n";
    }
    my $json_body = $api_res->content;
    open(my $outfh, ">", $cache_file) or die "Error opening $cache_file for write: $!";
    print $outfh $json_body;
    close($outfh) or die;
    return $json_body;
}

package Edge;

sub new {
    my ($class, $n1, $edge_type, $n2) = @_;
    return bless {
	n1   => $n1,
	edge => $edge_type,
	n2   => $n2,
    };
}

sub hashkey {
    my $self = shift;
    return $self->{_hashkey} ||= join($;, map { $self->{$_} } qw(n1 edge n2));
}

sub as_string {
    my $self = shift;
    return join(" ", map { $self->{$_} } qw(n1 edge n2));
}

sub mark_as_expected { $_[0]{expected} = 1 }
sub expected         { $_[0]{expected} }

sub mark_as_found { $_[0]{found} = 1 }
sub found         { $_[0]{found} }

sub mark_as_unwanted { $_[0]{unwanted} = 1 }
sub unwanted         { $_[0]{unwanted} }

